home *** CD-ROM | disk | FTP | other *** search
/ Turnbull China Bikeride / Turnbull China Bikeride - Disc 2.iso / STUTTGART / TEX-DIST / DISK1.GZ00 / fnts / Fonts.decache < prev    next >
Text File  |  1994-01-25  |  3KB  |  120 lines
  1. #!/usr/local/bin/perl
  2. #
  3. # Take pk fonts from the cache and install in the correct
  4. # directory. Decides whether a bitmap font should be generated.
  5. # Asks about each font before installing.
  6.  
  7. sub abs { ($_[0] > 0) ? $_[0] : -$_[0]; }
  8.  
  9. # Directories are numbered mf1...mf$mfdirs
  10. $mfdirs = 5;
  11.  
  12. # "Best" resolution of a bitmap font
  13. $dpi = 300;
  14.  
  15. chdir('$.usr.local.TeX.Fonts');
  16. while (<cache.*>)
  17. {
  18.     # Only handle directories in the cache directory.
  19.     if (-d $_)
  20.     {
  21.         s/cache\.//;
  22.         $font = $_;
  23.         print "$font: Install ? ";
  24.         chop($_ = <STDIN>);
  25.         if (/^[Yy]/)
  26.         {
  27.             # Find the font's home directory.
  28.             $j = 0;
  29.             for ($i=1; $i<=$mfdirs; $i++)
  30.             {
  31.                 if (-d "mf$i.$font")
  32.                 {
  33.                     $j = $i;
  34.                 }
  35.             }
  36.             if ($j == 0)
  37.             {
  38.                 die "Can't find $font"."'s directory\n";
  39.             }
  40.  
  41.             # Move all the pk fonts across.
  42.             print "Moving the pk fonts...";
  43.             while (<cache.$font.*pk>)
  44.             {
  45.                 /\.([0-9]+pk)/;
  46.                 rename("cache.$font.$1", "mf$j.$font.$1");
  47.                 print "$1...";
  48.             }
  49.             print "\n";
  50.  
  51.             # Now decide whether to make a font file.
  52.             print "Checking for RISC OS font...";
  53.             if ((-f "mf$j.$font.IntMetrics") && (-f "mf$j.$font.Outlines"))
  54.             {
  55.                 print "Congratulations! It's an outline font!\n";
  56.             }
  57.             else
  58.             {
  59.                 # Look through the PK fonts present and try
  60.                 # to find the "best". My definition of "best"
  61.                 # is "Closest to $dpi"
  62.  
  63.                 print "Hmmm, it's a bitmap. I'll try to optimise!\n";
  64.  
  65.                 chdir("mf$j.$font");
  66.                 $best = 0;
  67.                 while (<*pk>)
  68.                 {
  69.                     /([0-9]+)pk/;
  70.                     if (&abs($1 - $dpi) < &abs($best - $dpi))
  71.                     {
  72.                         $best = $1;
  73.                     }
  74.                 }
  75.  
  76.                 if ($best == 0)
  77.                 {
  78.                     print "No improvement found\n";
  79.                 }
  80.                 else
  81.                 {
  82.                     print "OK. I'm going to make a $best dpi font\n";
  83.  
  84.                     # Open the "x90y45" file to get the bitmap name.
  85.                     # Check that the real bitmap exists.
  86.                     if ((open(FONT, "x90y45")) && 
  87.                         ($realfont = <FONT>) &&
  88.                         (close(FONT)) &&
  89.                         (-f $realfont))
  90.                     {
  91.  
  92.                         # OK, they've all passed the tests
  93.                         # Zap the old font files.
  94.                         print "Deleting the old bitmaps\n";
  95.                         unlink($realfont);
  96.                         unlink("IntMetrics");
  97.                         unlink("x90y45");
  98.                     }
  99.  
  100.                     # Move back up a directory, temporarily 
  101.                     # unpack the "best" entry and create the
  102.                     # RISC OS font.
  103.                     chdir("^");
  104.                     system("pktogf $font.$best"."pk $font.$best"."gf");
  105.                     system("gftofnt -v1 $font.$best"."gf");
  106.                     unlink("$font.$best"."gf");
  107.                     chdir("^");
  108.                 }
  109.             }
  110.             # Ok, installed the font. Now zap the cache entry
  111.             print "Removing cache entry\n";
  112.             while (<cache.$font.*>)
  113.             {
  114.                 unlink("$_");
  115.             }
  116.             unlink("cache.$font");
  117.         }
  118.     }
  119. }
  120. chdir('\\');